home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / CALDAT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  653b  |  24 lines
  1. PROCEDURE caldat(julian: integer; VAR mm,id,iyyy: integer);
  2. CONST
  3.    igreg=2299161;
  4. VAR
  5.    je,jd,jc,jb,jalpha,ja: integer;
  6. BEGIN
  7.    IF (julian >= igreg) THEN BEGIN
  8.       jalpha := trunc(((julian-1867216)-0.25)/36524.25);
  9.       ja := julian+1+jalpha-trunc(0.25*jalpha)
  10.    END ELSE BEGIN
  11.       ja := julian
  12.    END;
  13.    jb := ja+1524;
  14.    jc := trunc(6680.0+((jb-2439870)-122.1)/365.25);
  15.    jd := 365*jc+trunc(0.25*jc);
  16.    je := trunc((jb-jd)/30.6001);
  17.    id := jb-jd-trunc(30.6001*je);
  18.    mm := je-1;
  19.    IF (mm > 12) THEN mm := mm-12;
  20.    iyyy := jc-4715;
  21.    IF (mm > 2) THEN iyyy := iyyy-1;
  22.    IF (iyyy <= 0) THEN iyyy := iyyy-1
  23. END;
  24.